import Data.ByteString.Builder
import qualified Data.ByteString as S
import qualified Data.ByteString.Short as S (toShort, fromShort)
-import qualified System.FilePath.ByteString as P
import System.PosixCompat.Files (isRegularFile)
import Text.Read
forM_ files move
where
move f = do
- let f' = toRawFilePath f
- let k = fileKey1 (fromRawFilePath (P.takeFileName f'))
- let d = parentDir f'
+ let k = fileKey1 (fromOsPath $ takeFileName f)
+ let d = parentDir f
liftIO $ allowWrite d
- liftIO $ allowWrite f'
- _ <- moveAnnex k (AssociatedFile Nothing) f'
- liftIO $ removeDirectory (fromRawFilePath d)
+ liftIO $ allowWrite f
+ _ <- moveAnnex k (AssociatedFile Nothing) f
+ liftIO $ removeDirectory d
updateSymlinks :: Annex ()
updateSymlinks = do
showAction "updating symlinks"
top <- fromRepo Git.repoPath
(files, cleanup) <- inRepo $ LsFiles.inRepo [] [top]
- forM_ files (fixlink . fromRawFilePath)
+ forM_ files fixlink
void $ liftIO cleanup
where
fixlink f = do
case r of
Nothing -> noop
Just (k, _) -> do
- link <- fromRawFilePath
- <$> calcRepo (gitAnnexLink (toRawFilePath f) k)
+ link <- calcRepo (gitAnnexLink f k)
liftIO $ removeFile f
- liftIO $ R.createSymbolicLink (toRawFilePath link) (toRawFilePath f)
- Annex.Queue.addCommand [] "add" [Param "--"] [f]
+ liftIO $ R.createSymbolicLink (fromOsPath link) (fromOsPath f)
+ Annex.Queue.addCommand [] "add" [Param "--"] [(fromOsPath f)]
moveLocationLogs :: Annex ()
moveLocationLogs = do
oldlocationlogs = do
dir <- fromRepo Upgrade.V2.gitStateDir
ifM (liftIO $ doesDirectoryExist dir)
- ( mapMaybe oldlog2key
+ ( mapMaybe (oldlog2key . fromOsPath)
<$> liftIO (getDirectoryContents dir)
, return []
)
move (l, k) = do
dest <- fromRepo (logFile2 k)
dir <- fromRepo Upgrade.V2.gitStateDir
- let f = dir </> l
- createWorkTreeDirectory (parentDir (toRawFilePath dest))
+ let f = dir </> toOsPath l
+ createWorkTreeDirectory (parentDir dest)
-- could just git mv, but this way deals with
-- log files that are not checked into git,
-- as well as merging with already upgraded
old <- liftIO $ readLog1 f
new <- liftIO $ readLog1 dest
liftIO $ writeLog1 dest (old++new)
- Annex.Queue.addCommand [] "add" [Param "--"] [dest]
- Annex.Queue.addCommand [] "add" [Param "--"] [f]
- Annex.Queue.addCommand [] "rm" [Param "--quiet", Param "-f", Param "--"] [f]
+ Annex.Queue.addCommand [] "add" [Param "--"] [fromOsPath dest]
+ Annex.Queue.addCommand [] "add" [Param "--"] [fromOsPath f]
+ Annex.Queue.addCommand [] "rm" [Param "--quiet", Param "-f", Param "--"] [fromOsPath f]
oldlog2key :: FilePath -> Maybe (FilePath, Key)
oldlog2key l
fileKey1 file = readKey1 $
replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file
-writeLog1 :: FilePath -> [LogLine] -> IO ()
-writeLog1 file ls = viaTmp F.writeFile
- (toOsPath (toRawFilePath file))
- (toLazyByteString $ buildLog ls)
+writeLog1 :: OsPath -> [LogLine] -> IO ()
+writeLog1 file ls = viaTmp F.writeFile file (toLazyByteString $ buildLog ls)
-readLog1 :: FilePath -> IO [LogLine]
-readLog1 file = catchDefaultIO [] $
- parseLog <$> F.readFile (toOsPath (toRawFilePath file))
+readLog1 :: OsPath -> IO [LogLine]
+readLog1 file = catchDefaultIO [] $ parseLog <$> F.readFile file
-lookupKey1 :: FilePath -> Annex (Maybe (Key, Backend))
+lookupKey1 :: OsPath -> Annex (Maybe (Key, Backend))
lookupKey1 file = do
tl <- liftIO $ tryIO getsymlink
case tl of
Left _ -> return Nothing
Right l -> makekey l
where
- getsymlink = takeFileName . fromRawFilePath
- <$> R.readSymbolicLink (toRawFilePath file)
+ getsymlink :: IO OsPath
+ getsymlink = takeFileName . toOsPath
+ <$> R.readSymbolicLink (fromOsPath file)
makekey l = maybeLookupBackendVariety (fromKey keyVariety k) >>= \case
Nothing -> do
unless (null kname || null bname ||
- not (isLinkToAnnex (toRawFilePath l))) $
+ not (isLinkToAnnex (fromOsPath l))) $
warning (UnquotedString skip)
return Nothing
Just backend -> return $ Just (k, backend)
where
- k = fileKey1 l
+ k = fileKey1 (fromOsPath l)
bname = decodeBS (formatKeyVariety (fromKey keyVariety k))
kname = decodeBS (S.fromShort (fromKey keyName k))
- skip = "skipping " ++ file ++
+ skip = "skipping " ++ fromOsPath file ++
" (unknown backend " ++ bname ++ ")"
-getKeyFilesPresent1 :: Annex [FilePath]
-getKeyFilesPresent1 = getKeyFilesPresent1' . fromRawFilePath
- =<< fromRepo gitAnnexObjectDir
-getKeyFilesPresent1' :: FilePath -> Annex [FilePath]
+getKeyFilesPresent1 :: Annex [OsPath]
+getKeyFilesPresent1 = getKeyFilesPresent1' =<< fromRepo gitAnnexObjectDir
+getKeyFilesPresent1' :: OsPath -> Annex [OsPath]
getKeyFilesPresent1' dir =
ifM (liftIO $ doesDirectoryExist dir)
( do
dirs <- liftIO $ getDirectoryContents dir
- let files = map (\d -> dir ++ "/" ++ d ++ "/" ++ takeFileName d) dirs
+ let files = map (\d -> dir <> literalOsPath "/" <> d <> literalOsPath "/" <> takeFileName d) dirs
liftIO $ filterM present files
, return []
)
where
+ present :: OsPath -> IO Bool
present f = do
- result <- tryIO $ R.getFileStatus (toRawFilePath f)
+ result <- tryIO $ R.getFileStatus (fromOsPath f)
case result of
Right s -> return $ isRegularFile s
Left _ -> return False
-logFile1 :: Git.Repo -> Key -> String
-logFile1 repo key = Upgrade.V2.gitStateDir repo ++ keyFile1 key ++ ".log"
-
-logFile2 :: Key -> Git.Repo -> String
+logFile2 :: Key -> Git.Repo -> OsPath
logFile2 = logFile' (hashDirLower def)
-logFile' :: (Key -> RawFilePath) -> Key -> Git.Repo -> String
+logFile' :: (Key -> OsPath) -> Key -> Git.Repo -> OsPath
logFile' hasher key repo =
- gitStateDir repo ++ fromRawFilePath (hasher key) ++ fromRawFilePath (keyFile key) ++ ".log"
+ gitStateDir repo <> hasher key <> keyFile key <> literalOsPath ".log"
-stateDir :: FilePath
-stateDir = addTrailingPathSeparator ".git-annex"
+stateDir :: OsPath
+stateDir = addTrailingPathSeparator (literalOsPath ".git-annex")
-gitStateDir :: Git.Repo -> FilePath
-gitStateDir repo = addTrailingPathSeparator $
- fromRawFilePath (Git.repoPath repo) </> stateDir
+gitStateDir :: Git.Repo -> OsPath
+gitStateDir repo = addTrailingPathSeparator $ Git.repoPath repo </> stateDir
import Logs
import Messages.Progress
import qualified Utility.FileIO as F
+import qualified Utility.OsString as OS
-olddir :: Git.Repo -> FilePath
+olddir :: Git.Repo -> OsPath
olddir g
- | Git.repoIsLocalBare g = ""
- | otherwise = ".git-annex"
+ | Git.repoIsLocalBare g = literalOsPath ""
+ | otherwise = literalOsPath ".git-annex"
{- .git-annex/ moved to a git-annex branch.
-
e <- liftIO $ doesDirectoryExist old
when e $ do
config <- Annex.getGitConfig
- mapM_ (\(k, f) -> inject f $ fromRawFilePath $ locationLogFile config k) =<< locationLogs
+ mapM_ (\(k, f) -> inject f $ locationLogFile config k) =<< locationLogs
mapM_ (\f -> inject f f) =<< logFiles old
saveState False
showProgressDots
when e $ do
- inRepo $ Git.Command.run [Param "rm", Param "-r", Param "-f", Param "-q", File old]
+ inRepo $ Git.Command.run [Param "rm", Param "-r", Param "-f", Param "-q", File (fromOsPath old)]
unless bare $ inRepo gitAttributesUnWrite
showProgressDots
return UpgradeSuccess
-locationLogs :: Annex [(Key, FilePath)]
+locationLogs :: Annex [(Key, OsPath)]
locationLogs = do
config <- Annex.getGitConfig
dir <- fromRepo gitStateDir
liftIO $ do
- levela <- dirContents (toRawFilePath dir)
+ levela <- dirContents dir
levelb <- mapM tryDirContents levela
files <- mapM tryDirContents (concat levelb)
return $ mapMaybe (islogfile config) (concat files)
where
tryDirContents d = catchDefaultIO [] $ dirContents d
- islogfile config f = maybe Nothing (\k -> Just (k, fromRawFilePath f)) $
+ islogfile config f = maybe Nothing (\k -> Just (k, f)) $
locationLogFileKey config f
-inject :: FilePath -> FilePath -> Annex ()
+inject :: OsPath -> OsPath -> Annex ()
inject source dest = do
old <- fromRepo olddir
- new <- liftIO (readFile $ old </> source)
- Annex.Branch.change (Annex.Branch.RegardingUUID []) (toRawFilePath dest) $ \prev ->
+ new <- liftIO (readFile $ fromOsPath $ old </> source)
+ Annex.Branch.change (Annex.Branch.RegardingUUID []) dest $ \prev ->
encodeBL $ unlines $ nub $ lines (decodeBL prev) ++ lines new
-logFiles :: FilePath -> Annex [FilePath]
-logFiles dir = return . filter (".log" `isSuffixOf`)
+logFiles :: OsPath -> Annex [OsPath]
+logFiles dir = return . filter (literalOsPath ".log" `OS.isSuffixOf`)
<=< liftIO $ getDirectoryContents dir
push :: Annex ()
{- Old .gitattributes contents, not needed anymore. -}
attrLines :: [String]
attrLines =
- [ stateDir </> "*.log merge=union"
- , stateDir </> "*/*/*.log merge=union"
+ [ fromOsPath $ stateDir </> literalOsPath "*.log merge=union"
+ , fromOsPath $ stateDir </> literalOsPath "*/*/*.log merge=union"
]
gitAttributesUnWrite :: Git.Repo -> IO ()
gitAttributesUnWrite repo = do
let attributes = Git.attributes repo
- let attributes' = fromRawFilePath attributes
- whenM (doesFileExist attributes') $ do
+ whenM (doesFileExist attributes) $ do
c <- map decodeBS . fileLines'
- <$> F.readFile' (toOsPath attributes)
- liftIO $ viaTmp (writeFile . fromRawFilePath . fromOsPath)
- (toOsPath attributes)
+ <$> F.readFile' attributes
+ liftIO $ viaTmp (writeFile . fromOsPath) attributes
(unlines $ filter (`notElem` attrLines) c)
- Git.Command.run [Param "add", File attributes'] repo
+ Git.Command.run [Param "add", File (fromOsPath attributes)] repo
-stateDir :: FilePath
-stateDir = addTrailingPathSeparator ".git-annex"
+stateDir :: OsPath
+stateDir = addTrailingPathSeparator (literalOsPath ".git-annex")
-gitStateDir :: Git.Repo -> FilePath
-gitStateDir repo = addTrailingPathSeparator $
- fromRawFilePath (Git.repoPath repo) </> stateDir
+gitStateDir :: Git.Repo -> OsPath
+gitStateDir repo = addTrailingPathSeparator $ Git.repoPath repo </> stateDir
import Utility.InodeCache
import Utility.DottedVersion
import Annex.AdjustedBranch
-import qualified Utility.RawFilePath as R
import qualified Utility.FileIO as F
upgrade :: Bool -> Annex UpgradeResult
stagePointerFile f Nothing =<< hashPointerFile k
ifM (isJust <$> getAnnexLinkTarget f)
( writepointer f k
- , fromdirect (fromRawFilePath f) k
+ , fromdirect f k
)
Database.Keys.addAssociatedFile k
=<< inRepo (toTopFilePath f)
fromdirect f k = ifM (Direct.goodContent k f)
( do
- let f' = toRawFilePath f
-- If linkToAnnex fails for some reason, the work tree
-- file still has the content; the annex object file
-- is just not populated with it. Since the work tree
-- file is recorded as an associated file, things will
-- still work that way, it's just not ideal.
- ic <- withTSDelta (liftIO . genInodeCache f')
- void $ Content.linkToAnnex k f' ic
+ ic <- withTSDelta (liftIO . genInodeCache f)
+ void $ Content.linkToAnnex k f ic
, unlessM (Content.inAnnex k) $ do
-- Worktree file was deleted or modified;
-- if there are no other copies of the content
)
writepointer f k = liftIO $ do
- removeWhenExistsWith R.removeLink f
- F.writeFile' (toOsPath f) (formatPointer k)
+ removeWhenExistsWith removeFile f
+ F.writeFile' f (formatPointer k)
{- Remove all direct mode bookkeeping files. -}
removeDirectCruft :: Annex ()
projects / git-annex.git / commitdiff